home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / wndw40.zip / WNDW40-.PAS < prev    next >
Pascal/Delphi Source File  |  1987-12-11  |  25KB  |  545 lines
  1. { =========================================================================== }
  2. { Wndw40-.pas - unit for random-access, multi-level windows ver 4.0, 12-12-87 }
  3. {                                                                             }
  4. { This file has a partial code listing for serial and random access,          }
  5. { multi-level windows.  It works on any IBM or compatible including PCjr,     }
  6. { IBM 3270 PC, and the PS/2 systems, in any video mode.  It uses QWIK40.TPU   }
  7. { for fast screen writing on any video page.                                  }
  8. {  (c) James H. LeMay 1987                                                    }
  9. { =========================================================================== }
  10.  
  11. {$R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }
  12.  
  13. UNIT Wndw;
  14.  
  15. INTERFACE
  16.  
  17. USES Crt,Qwik,WndwVars;
  18.  
  19. { -- Basic Window Utilities -- }
  20. function  Attr            (Foreground,Background: byte): byte;
  21. procedure Qbox            (Row,Col,Rows,Cols: byte; Wattr,Battr: integer;
  22.                            BrdrSel: Borders);
  23. procedure RestoreTurboWindow;
  24. procedure InitWindow      (Wattr: integer; ClearScr: boolean);
  25. function  HeapOK          (NumOfBytes: word): boolean;
  26. procedure SetWindowModes  (SumOfAllModes: byte);
  27. procedure MakeWindow      (Row,Col,Rows,Cols: byte; Wattr,Battr: integer;
  28.                            BrdrSel: Borders; WindowName: WindowNames);
  29. procedure PartitionWindow (Partition: DirType; WindowRowOrCol: byte);
  30. procedure PartitionCross  (WindowRow, WindowCol: byte);
  31. procedure RemoveWindow;
  32. procedure TitleWindow     (TopOrBottom,Justify: DirType; Title: string);
  33. procedure ClearTitle      (TopOrBottom: DirType);
  34. procedure ClearWindow;
  35. procedure ScrollWindow    (RowBegin,RowEnd: byte; Dir: DirType);
  36.  
  37. { -- Window management utilities -- }
  38. procedure HideWindow;
  39. procedure ShowWindow      (WindowName: WindowNames);
  40. procedure MoveWindow      (Dir: DirType; NumOfChars: byte);
  41. function  GetLevelIndex   (WindowName: WindowNames): byte;
  42. procedure AccessWindow    (WindowName: WindowNames);
  43.  
  44. IMPLEMENTATION
  45. const
  46.   NoShadow         = $00;
  47.   BothShadows      = $0C;  { ShadowLeft+ShadowRight }
  48.   FixedOrPermModes = $03;  { FixedMode+PermMode }
  49.  
  50. { =========================================================================== }
  51. { NAME: Attr                                               ver 4.0,  12-12-87 }
  52. { DESCRIPTION: Converts Turbo color constants into an attribute and masks     }
  53. {              any accidental blink bit.  However, the use of the new         }
  54. {              background colors constants in WNDWVARS.PAS is recommended     }
  55. {              in lieu of this function.                                      }
  56. { PARAMETERS:  ForeGround - Color of text foreground                          }
  57. {              BackGround - Color of text background                          }
  58. { =========================================================================== }
  59. function Attr;  { (Foreground,Background: byte): byte; }
  60. begin
  61.   Attr := ((BackGround shl 4) + ForeGround) and $7F;
  62. end;
  63.  
  64. { =========================================================================== }
  65. { NAME: RestoreTurboWindow                                  ver 4.0, 12-12-87 }
  66. { DESCRIPTION:  Restores the Turbo window, attribute, cursor location,        }
  67. {               and window identification for the top Level Index.            }
  68. { =========================================================================== }
  69. procedure RestoreTurboWindow;
  70. begin
  71.   with TopWndwStat do
  72.     begin
  73.       TextAttr:=WSWattr;    { Turbo's Attribute }
  74.       if VideoPage=0 then
  75.         if WSbrdr=NoBrdr then
  76.              window (WScol,WSrow,WScol2,WSrow2)
  77.         else window (succ(WScol),succ(WSrow),pred(WScol2),pred(WSrow2));
  78.       GotoRC (WSwhereR,WSwhereC);
  79.     end
  80. end;
  81.  
  82. { =========================================================================== }
  83. { NAME: InitWindow                                          ver 4.0, 12-12-87 }
  84. { DESCRIPTION:  Initializes the window variables.  Run this routine first!    }
  85. { PARAMETERS:                                                                 }
  86. {       Wattr    - Starting window attribute (0-255)                          }
  87. {       ClearScr - Set to true if you want the screen initially cleared       }
  88. { =========================================================================== }
  89. procedure InitWindow;  { (Wattr: integer; ClearScr: boolean); }
  90. begin
  91.   CheckSnow:=Qsnow;
  92.   LI:=0;                          { Current Level Index }
  93.   HLI:=MaxWndw+1;                 { Hidden window Level Index }
  94.   with TopWndwStat,Margins do     { Set top level stats }
  95.     begin
  96.       WSrow   := 1;           WSWattr  := Wattr;
  97.       WScol   := 1;           WSBattr  := Wattr;
  98.       WSrows  := CRTrows;     WSbrdr   := NoBrdr;
  99.       WScols  := CRTcols;     WSname   := Window0;
  100.       WSrow2  := CRTrows;     WSwhereR := 1;
  101.       WScol2  := CRTcols;     WSwhereC := 1;
  102.       WSmodes := PermMode;
  103.       ULbytes := 0;
  104.       WndwStat[0]  := TopWndwStat;    { Save a copy }
  105.       LeftMargin   := WScol;
  106.       RightMargin  := WScol2;
  107.       TopMargin    := WSrow;
  108.       BottomMargin := WSrow2;
  109.       WindowModes  := 0;
  110.       case SystemID of
  111.         $FC,$F8: ZoomDelay:=18;  { 80286 or 80386 machines }
  112.       else ZoomDelay:=12;
  113.       end;
  114.       RestoreTurboWindow;
  115.       if ClearScr then
  116.         Qfill (1,1,CRTrows,CRTcols,Wattr,' ');
  117.     end;
  118. end;
  119.  
  120. { =========================================================================== }
  121. { NAME: SetWindowModes                                      ver 4.0, 12-12-87 }
  122. { DESCRIPTION:  Checks and set the variable WindowModes.                      }
  123. { PARAMETERS:   SumOfAllModes - A sum of all the modes added together.        }
  124. { =========================================================================== }
  125. procedure SetWindowModes; { (SumOfAllModes: byte); }
  126. begin
  127.   { -- Turn off HideMode -- }
  128.   WindowModes:=SumOfAllModes and ($FF-HideMode);
  129.   { -- if both shadows, clear ShadowLeft -- }
  130.   if (WindowModes and BothShadows)=BothShadows then
  131.     WindowModes:=WindowModes-ShadowLeft;
  132. end;
  133.  
  134. { =========================================================================== }
  135. { NAME: HeapOK                                              ver 4.0, 12-12-87 }
  136. { DESCRIPTION:  Checks for enough memory on the heap used by MakeWindow.      }
  137. { PARAMETERS:   NumOfBytes - number of bytes needed on the heap               }
  138. { =========================================================================== }
  139. function HeapOK;  { (NumOfBytes: word): boolean; }
  140. begin
  141.   if maxavail<NumOfBytes then
  142.     begin
  143.       ProgrammingError (1);
  144.       HeapOK := false
  145.     end
  146.   else HeapOK := true
  147. end;
  148.  
  149. { =========================================================================== }
  150. { NAME: Qbox                                               ver 4.0,  12-12-87 }
  151. { DESCRIPTION: Writes a window with optional border.                          }
  152. { PARAMETERS:  See MakeWindow.                                                }
  153. { =========================================================================== }
  154. procedure Qbox; {  (Row,Col,Rows,Cols: byte;
  155.                     Wattr,Battr: integer; BrdrSel: Borders); }
  156. var  Row2,Col2: byte;
  157. begin
  158.   if (Rows>=2) and (Cols>=2) then
  159.     begin
  160.       Row2:=pred(Row+Rows);
  161.       Col2:=pred(Col+Cols);
  162.       if BrdrSel<>NoBrdr then
  163.         with Brdr[BrdrSel] do
  164.           begin
  165.             Qwrite (     Row ,     Col               ,Battr,TL);
  166.             Qfill  (     Row ,succ(Col),1     ,Cols-2,Battr,TH);
  167.             Qwrite (     Row ,     Col2              ,Battr,TR);
  168.             Qfill  (succ(Row),     Col ,Rows-2,1     ,Battr,LV);
  169.             Qfill  (succ(Row),     Col2,Rows-2,1     ,Battr,RV);
  170.             Qwrite (     Row2,     Col               ,Battr,BL);
  171.             Qfill  (     Row2,succ(Col),1     ,Cols-2,Battr,BH);
  172.             Qwrite (     Row2,     Col2              ,Battr,BR);
  173.             Qfill  (succ(Row),succ(Col),Rows-2,Cols-2,Wattr,' ')
  174.           end
  175.       else Qfill  (Row,Col,Rows,Cols,Wattr,' ');
  176.   end;
  177. end;
  178.  
  179. { =====================